COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.SBTTL Free storage management
C00009 ENDMK
C⊗;
.SBTTL Free storage management

; Assembly variables
FREL = 4000		;Test of small amount.  Maximum = 40000 (IN WORDS!)

; Free storage block
.EVEN
FREEPT:	FREEST
	-1		;Left bdry tag is negative.
FREEST:	FREL*2		;Beginning of free storage.  Boundary tag.
	.BLKW	FREL-2	;
FREEND:	FREL*2		;End of free storage.  Boundary tag.
	-1		;Right bdry tag is negative.

; Routine to initialize storage.  Need only call if you think
;	storage has been munged, or you want to start over for
;	some reason.
FRINIT:	MOV #FREL*2,FREEST	;Lower inner tag
	MOV #FREL*2,FREEND	;Upper inner tag
	MOV #FREEST,FREEPT	;Roving free pointer
	CMP FREEST-2,FREEND+2	;Do the two outer tags agree?
	BNE FRINER		;No.
	RTS PC			;Yes.  Return.
FRINER:	HALERR FRINMS
FRINMS:	ASCIE /FRINIT FEARS FREE STORAGE HAS BEEN MUNGED/

; Routine to assign storage.  Amount of words requested in R0.
;	Location of first word in block (not the boundary tag) returned
;	in R0.
;  The boundary tag method described in Knuth I.2.5 is
;	used.  Each block of storage has a boundary tag at
;	each end, with identical contents:  The number
;	of bytes in the whole area if available, and the opposite
;	of that if busy.  Artificial busy areas above and below
;	free storage.
GTFREE:	MOV R2,-(SP)	;Save R2 on stack.
	ASL R0		;Convert words to bytes
	BLT FREERR	;Asked for negative number of words.
	ADD #4, R0	;Need 2 extra words for boundary tags
	MOV FREEPT, R1	;R1 ← running LOC[LTAG[*]]
FRTRY:	CMP R1,#FREEND	;Are we off the end of free storage?
	BLOS FR2	;No.
	MOV #FREEST,R1	;Yes.  Reset pointer to beginning.
FR2:	CMP (R1),R0	;Do we have enough room here?
	BGE FFOUND	;Yes
	TST (R1)	;No.  Is this area busy?  If so, its count is negative.
	BGE FRPOS	;No.
	SUB (R1),R1	;Yes.  R1 ← LOC[LTAG[next] by subtraction.
	BR  FR1
FRPOS:	ADD (R1),R1	;R1 ← LOC[LTAG[next] by addition.
FR1:	CMP R1,FREEPT	;Have we cycled all through free storage
	BEQ FROVFL	;Yes.  No room!
	BR  FRTRY	;No.  Try again.
FFOUND:	BEQ FEXACT	;If 0, then exact fit.
	MOV R1,R2	;Divide the found block into FOUND and HOLE.
			;Thus, R1 = LOC[LTAG[FOUND]].
	ADD R0,R2	;R2 ← LOC[LTAG[HOLE]]
	NEG R0		;R0 ← negative (busy) count of FOUND.
	MOV R0,-2(R2)	;RTAG[FOUND] ← new FOUND count.
	MOV R0,-(SP)	;Save R0.
	ADD (R1),R0	;R0 ← new HOLE count.
	MOV R0,(R2)	;LTAG[HOLE] ← new HOLE count.
	MOV R2,FREEPT	;Free pointer ← LOC[LTAG[HOLE]]
	MOV R1,R2	;
	TST -(R2)	;
	ADD (R1),R2	;R2 ← LOC[RTAG[HOLE]].
	MOV R0,(R2)	;RTAG[HOLE] ← new HOLE count.
	MOV (SP)+,(R1)+	;LTAG[FOUND] ← new FOUND count.
FRRET:	MOV R1,R0	;R0 (result) ← LOC[LTAG[FOUND]] + 1.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done.
FEXACT:	MOV R1,R2	;
	ADD (R1),R2	;R2 ← LOC[RTAG[FOUND]]
	NEG (R1)+	;LTAG[FOUND] ← new (busy) count.
	NEG -(R2)	;RTAG[FOUND] ← new (busy) count.
	BR FRRET	;Ready to return
FREERR:	HALERR FRMS1
FROVFL:	HALERR FRMS2
FRMS1:	ASCIE </YOU ASKED FOR NEGATIVE AMOUNT OF FREE SPACE/>
FRMS2:	ASCIE /FREE STORAGE EXHAUSTED/


; Routine to release free storage.  R0=LOC[LTAG[BLOCK]] + 1.
; Call the currently released block BLOCK, the adjacent one
;	below LOW, and the adjacent one above HIGH.
RLFREE:	MOV -(R0),R1	;R1 ← LOC[LTAG[BLOCK]]
	BGE RLFER2	;Can't release available space.
	MOV R0,R1	;R1 ← LOC[LTAG[BLOCK]]
	SUB (R0),R0	;R0 ← LOC[LTAG[HIGH]]
	CMP (R1),-2(R0)	;Do the two bdry tags agree?
	BNE RLFER1	;No.  Storage munged!!
	NEG (R1)	;Count is now positive in LTAG[BLOCK].
	TST -2(R1)	;Is LOW available?
	BLT MERGR	;No.  Cannot merge left.
	ADD -2(R1),(R1)	;Yes.  LTAG[BLOCK] ← New count
	MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
	MOV R0,R1	;
	SUB -2(R1),R1	;R1 ← LOC[LTAG[LOW]]
	MOV -2(R0),(R1)	;LTAG[LOW] ← New count
			;At this point, call LOW&BLOCK = BLOCK.
MERGR:	TST (R0)	;Is HIGH available?
	BLT RLRET	;No.  Prepare to return.
	ADD (R0),(R1)	;LTAG[BLOCK] ← New count
	CMP FREEPT,R0	;Will FREEPT point into a vacuum?
	BNE RL1		;No.
	MOV R1,FREEPT	;Yes.  Reset FREEPT ← LOC[LTAG[BLOCK]]
RL1:	ADD (R0),R0	;R0 ← LOC[RTAG[HIGH]] + 1
			;At this point, call BLOCK&HIGH = BLOCK.
RLRET:	MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
	RTS PC		;Done.
RLFER1:	HALERR RLMS1
RLFER2:	HALERR RLMS2
RLMS1:	ASCIE /RLFREE FEARS FREE STORAGE IS WIPED OUT/
RLMS2:	ASCIE /ATTEMPT TO FREE ALREADY AVAILABLE SPACE/